perm filename XGPSYN.SAI[CSP,SYS]1 blob
sn#481573 filedate 1979-10-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 DEFINE MAXESCAPE=20 comment set to zero for XGPSYN, ≥20 FOR XGPSYG
C00021 00003 HELPACT←FALSE DENS←0
C00023 00004 CHAN←GETCHAN START_CODE TTCALL '10,0 END comment RESCAN to read command line
C00027 00005 FPN←1 FPNR←0 S←"" PN←2
C00030 00006 DO
C00042 00007 IF PAGE ∧ PN>0 THEN
C00044 00008 comment assemble line of text
C00045 00009 comment calculate height of line
C00056 00010 assemble line
C00082 00011 IFC MAXESCAPE>0 THENC
C00083 00012 IFC MAXESCAPE>0 THENC ESCHIT←1 ENDC
C00095 00013 comment display page
C00099 ENDMK
C⊗;
DEFINE MAXESCAPE=20; comment set to zero for XGPSYN, ≥20 FOR XGPSYG;
BEGIN IFC MAXESCAPE>0 THENC "XGPSYG" ELSEC "XGPSYN" ENDC;
REQUIRE 7500 STRING_SPACE;
IFC MAXESCAPE>0 THENC REQUIRE "GRASET.SAI[GOD,HPM]" SOURCE_FILE;
STRING ESCAPE,ESCHIT; INTEGER NESCAPE; STRING ARRAY ESCCOM[1:MAXESCAPE];
INTEGER ARRAY ESCX,ESCY,ESCF,ESCL[1:MAXESCAPE]; INTEGER THIK; ENDC
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
REQUIRE "PGHDR.SAI[GOD,HPM]" SOURCE_FILE;
REQUIRE "SYNSUB.REL[PIX,HPM]" LOAD_MODULE;
EXTERNAL PROCEDURE HELPER; EXTERNAL PROCEDURE FONTNO(INTEGER N);
EXTERNAL PROCEDURE FIRST; EXTERNAL PROCEDURE FIRST1; EXTERNAL PROCEDURE FIRST2;
EXTERNAL PROCEDURE FIRST3; EXTERNAL PROCEDURE CRLF; EXTERNAL PROCEDURE FILNM;
BOOLEAN PRNT,XGP,WHITELET,OWNCH,HELPACT,AUTOCR,VARIAN,EDGEDO,NOQUE,NODPY,HEADING,TITLE;
INTEGER NCOPY,XSHIFT,YSHIFT, SPOOLFLAG;
INTEGER ARRAY FHD[0:'177,0:'203];
BOOLEAN PAGE;
INTEGER FNTN,SFNTN,EOF,FTH,FTB,XPOS,YPOS,XLINE,CHAN,DUN,PN,LASTFF,BASE,SBASE;
INTEGER INTERCHAR,UINTERCHAR,SINTERCHAR,LINLEN, LISTLO,LISTHI, LASTUSETI;
INTEGER XCMP,YCMP,YOFF,XOFF,BMAR,RMAR,LMAR,TMAR,PMAR,DENS,LUND,SDENS;
INTEGER I,J,K,NUMCH,TXTPNT, PN1,PN2,PN3,PN4;
DEFINE PAGEMAX=500; INTEGER ARRAY PNS[0:PAGEMAX];
REAL FPN,FPNR; STRING INSTR,INFILE,S,SWT,SPOOLF;
SIMPLE INTEGER PROCEDURE BYT(INTEGER PNT);
RETURN(((PNT LAND '777777) LSH 6) LOR ('77 - (PNT LSH -30)));
SIMPLE INTEGER PROCEDURE UCONV(INTEGER I);
RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
SIMPLE INTEGER PROCEDURE NXCH;
BEGIN INTEGER T;
IF LENGTH(INSTR)=0 ∧ ¬EOF THEN INSTR←INPUT(CHAN,1);
NUMCH←NUMCH+1; IDPB(T←LOP(INSTR),TXTPNT);
EOF←EOF ∨ NUMCH≥LASTUSETI;
RETURN(T); END;
PROCEDURE SWITCHES(STRING FNTNMS);
BEGIN
STRING PROCEDURE SKIPTO(INTEGER DELIM);
BEGIN STRING RET; RET←"";
WHILE LENGTH(FNTNMS)>0 ∧ FNTNMS≠DELIM ∧ FNTNMS≠"/" ∧ FNTNMS≠"#"
DO RET←RET&LOP(FNTNMS);
RETURN(RET);
END;
INTEGER FOO;
WHILE LENGTH(FNTNMS)>0 DO
BEGIN
WHILE LENGTH(FNTNMS)>0 ∧ LOP(FNTNMS)≠"/" DO;
IF EQU(FNTNMS[1 TO 1],"F") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
SKIPTO("=");
IF FNTNMS="#" THEN FTNO←INTSCAN(FNTNMS,FOO) ELSE FTNO←0;
FNTNMS←FNTNMS[2 TO ∞];
FTNM←SKIPTO("=");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
IF HELPACT THEN BEGIN FONTNO(FTNO); PRINT(FTNM," "); END;
WHILE FNTOPN(FTNO,FTNM,FHD[FTNO,0])<0 DO
BEGIN
PRINT("COULDN'T GET ",DEVPRS,":",FILPRS); CRLF;
PRINT("Try again:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PRSFIL(".FNT[XGP,SYS]");
FTNM←INCHWL;
IF HELPACT THEN BEGIN FONTNO(FTNO); PRINT(FTNM); END;
END;
IF FNTNMS="=" THEN
BEGIN
INTEGER ARRAY TERM[0:'177]; INTEGER I;
FNTNMS←FNTNMS[2 TO ∞];
ARRCLR(TERM);
DO BEGIN I←LOP(FNTNMS); TERM[I]←TERM[I]+1; END UNTIL TERM[I]≥2;
END;
END
IFC MAXESCAPE>0 THENC
ELSE IF EQU(FNTNMS[1 TO 2],"TH") THEN
BEGIN SKIPTO("=");
IF FNTNMS="=" THEN
BEGIN FNTNMS←FNTNMS[2 TO ∞]; THIK←INTSCAN(FNTNMS,FOO); END;
IF HELPACT THEN PRINT("THICKNESS=",THIK," ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"ESC") THEN
BEGIN
ESCAPE←"";
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN
WHILE LENGTH(FNTNMS)>0∧FNTNMS≠"/" DO ESCAPE←ESCAPE&LOP(FNTNMS);
IF HELPACT THEN PRINT("ESCAPE=",ESCAPE," ");
END
ENDC
ELSE IF EQU(FNTNMS[1 TO 2],"RE") THEN
BEGIN
INTEGER FTNO; STRING FTNM;
SKIPTO("=");
IF FNTNMS="=" THEN
BEGIN
FNTNMS←FNTNMS[2 TO ∞];
NCOPY←INTSCAN(FNTNMS,FOO);
END
ELSE NCOPY←2;
IF HELPACT THEN PRINT("REPEAT=",NCOPY," ");
END
ELSE IF EQU(FNTNMS[1 TO 2],"TM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN TMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("TMAR=",TMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"PM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN PMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("PMAR=",PMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"BM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN BMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("BMAR=",BMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"LM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN LMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("LMAR=",LMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 FOR 1],"L") THEN
BEGIN
INTEGER I; STRING S;
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
S←SKIPTO("/");
IF LENGTH(S)≤1 THEN BEGIN LISTLO←1;
LISTHI←(IF EOF THEN LASTFF+1 ELSE 9999); END
ELSE
BEGIN
I←LOP(S); WHILE LENGTH(S)>0∧(S="("∨S=" ") DO I←LOP(S);
LISTLO←INTSCAN(S,FOO);
WHILE LENGTH(S)>0∧(S=":"∨S=" ") DO I←LOP(S);
LISTHI←IF S="*" THEN 9999 ELSE INTSCAN(S,FOO);
IF LISTHI=0 THEN LISTHI←LISTLO;
END;
IF ¬SPOOLFLAG THEN
PRINT("listing ",LISTLO,":",
IF LISTHI=9999 THEN "*" ELSE CVS(LISTHI)," ...");
SDENS←IF DENS=0 THEN "F" ELSE DENS;
IF DENS≠"T" THEN DENS←"B";
PN←-1;
SPOOLFLAG←"/";
SPOOLF←"";
PAGE←FALSE;
END
ELSE IF EQU(FNTNMS[1 TO 2],"RM") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN RMAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("RMAR=",RMAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XL") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN XLINE←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("XLINE=",XLINE," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"IN") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN UINTERCHAR←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("INTERCHAR=",UINTERCHAR," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XS") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN XSHIFT←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("XSHIFT=",XSHIFT," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"YS") THEN
BEGIN
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN YSHIFT←INTSCAN(FNTNMS,FOO);
IF HELPACT THEN PRINT("YSHIFT=",YSHIFT," "); END;
END
ELSE IF EQU(FNTNMS[1 TO 2],"XG") THEN
BEGIN
SKIPTO("/");
XGP←TRUE;
HEADING←FALSE;
IF HELPACT THEN PRINT("XGP ");
END
ELSE IF EQU(FNTNMS[1 TO 2],"HE") THEN
BEGIN
SKIPTO("/");
HEADING←TRUE;
IF HELPACT THEN PRINT("HEADING ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOH") THEN
BEGIN
SKIPTO("/");
HEADING←FALSE;
IF HELPACT THEN PRINT("NOHEADING ");
END
ELSE IF EQU(FNTNMS[1 TO 2],"TI") THEN
BEGIN
SKIPTO("/");
TITLE←TRUE;
IF HELPACT THEN PRINT("TITLE ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOT") THEN
BEGIN
SKIPTO("/");
TITLE←FALSE;
IF HELPACT THEN PRINT("NOTITLE ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOX") THEN
BEGIN
SKIPTO("/");
XGP←FALSE;
HEADING←TRUE;
AUTOCR←TRUE;
IF HELPACT THEN PRINT("NOXGP ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOQ") THEN
BEGIN
SKIPTO("/");
NOQUE←TRUE;
IF HELPACT THEN PRINT("NOQUE ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOD") THEN
BEGIN
SKIPTO("/");
NODPY←TRUE;
IF HELPACT THEN PRINT("NODPY ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"AUT") THEN
BEGIN
SKIPTO("/");
AUTOCR←TRUE;
IF HELPACT THEN PRINT("AUTOCR ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"NOA") THEN
BEGIN
SKIPTO("/");
AUTOCR←FALSE;
IF HELPACT THEN PRINT("NOAUTOCR ");
END
ELSE IF EQU(FNTNMS[1 TO 3],"END") THEN
BEGIN
FNTNMS←"";
IF HELPACT THEN PRINT("END ");
END
ELSE IF EQU(FNTNMS[1 TO 2],"ED") THEN
BEGIN
SKIPTO("/");
EDGEDO←TRUE;
IF HELPACT THEN PRINT("EDGE ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"H") THEN
BEGIN
SKIPTO("/");
DENS←"H";
IF HELPACT THEN PRINT("HALF ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"F") THEN
BEGIN
SKIPTO("/");
DENS←"F";
IF HELPACT THEN PRINT("FULL ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"D") THEN
BEGIN
SKIPTO("/");
DENS←"D";
IF HELPACT THEN PRINT("DOUBLE ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"E") THEN
BEGIN
SKIPTO("/");
DENS←"E";
IF HELPACT THEN PRINT("ENORMOUS ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"B") THEN
BEGIN
SKIPTO("/");
DENS←"B";
IF HELPACT THEN PRINT("BITWISE ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"T") THEN
BEGIN
SKIPTO("/");
DENS←"T";
IF HELPACT THEN PRINT("TRANSPOSED ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"V") THEN
BEGIN
SKIPTO("/");
VARIAN←TRUE;
IF HELPACT THEN PRINT("VARIAN ");
END
ELSE IF EQU(FNTNMS[1 TO 1],"U") THEN
BEGIN
INTEGER FOO;
SKIPTO("=");
IF LOP(FNTNMS)="=" THEN BEGIN IF HELPACT THEN PRINT("USETI ");
USETI(CHAN,LASTUSETI←INTSCAN(FNTNMS,FOO));
LASTUSETI←(LASTUSETI-1)*'200*5; comment terminating character;
FNTNMS←"";
WHILE ¬EOF DO FNTNMS←FNTNMS&INPUT(CHAN,1);
LASTFF←10000; END;
END;
END;
END;
PROCEDURE SETOFFSET;
CASE DENS OF
BEGIN
["T"] BEGIN YOFF←-36-YSHIFT; XOFF←-XSHIFT; END;
["B"] BEGIN YOFF←-YSHIFT; XOFF←-36-XSHIFT; END;
["E"] BEGIN YOFF←TMAR-YSHIFT; XOFF←LMAR-XSHIFT; END;
["H"] BEGIN YOFF←TMAR+(FPN-PN+FPNR)*(480*4-30)-20-YSHIFT;
XOFF←(((LMAR-20) MIN (RMAR-3*512)) MAX -10)-XSHIFT; END;
["F"] BEGIN YOFF←TMAR-((512*4-PMAR)%2 MAX 0)+FPNR*512*4-YSHIFT;
XOFF←(((LMAR-20) MIN (RMAR-3*480)) MAX -10)-XSHIFT; END;
["D"] BEGIN YOFF←TMAR+FPNR*481*4-20-YSHIFT;
XOFF←(((LMAR-20) MIN (RMAR-3*512)) MAX -10)-XSHIFT; END
END;
STRING PROCEDURE GETINCHWL;
BEGIN
PRELOAD_WITH 0; OWN INTEGER ARRAY INDEX[1:1];
IF INDEX[1]=0 ∧ SPOOLFLAG ∧ (LISTLO>LISTHI ∨ (EOF ∧ LISTLO>LASTFF+1)) THEN
BEGIN
IF SPOOLFLAG="/" THEN CALL(0,"EXIT") ELSE
BEGIN PRINT("listing finished"); CRLF; END;
DENS←SDENS;
SPOOLFLAG←FALSE;
CASE DENS OF
BEGIN
["D"] BEGIN PRINT("FIRST PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END;
["F"]["B"]["E"] BEGIN PRINT("PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END;
ELSE
BEGIN PRINT("PAGE"); IF HELPACT THEN BEGIN FIRST1; FIRST; END; PRINT(":"); END
END;
END;
IF SPOOLFLAG THEN
BEGIN
INDEX[1]←(INDEX[1]+1) MOD 2;
IF INDEX[1]=1 THEN LISTLO←LISTLO+1;
RETURN(IF INDEX[1]=1 THEN CVS(LISTLO-1) ELSE "X");
END
ELSE RETURN(INCHWL);
END;
HELPACT←FALSE; DENS←0;
IFC MAXESCAPE>0 THENC ESCAPE←"⊂⊗⊃"; THIK←0; ENDC
FOR I←0 STEP 1 UNTIL '177 DO FHD[I,FNTHIG]←-1;
BREAKSET(1,"","A"); BREAKSET(1,'0&'177&'12&'14,"I");
BREAKSET(1,"","O"); BREAKSET(1,"","Z");
DDINIT;
NCOPY←1;
LASTUSETI←2↑34;
TMAR←200;
PMAR←1796;
BMAR←200;
LMAR←200;
RMAR←1650;
AUTOCR←TRUE;
NOQUE←FALSE;
NODPY←FALSE;
TITLE←TRUE;
HEADING←TRUE;
XLINE←4;
XSHIFT←YSHIFT←0;
UINTERCHAR←0;
SPOOLFLAG←FALSE;
WHITELET←FALSE;
VARIAN←FALSE;
EDGEDO←FALSE;
ARRCLR(PNS,-1);
BEGIN "FILE"
DEFINE FSIZE=10000;
INTEGER FOO,HIG,POS,I,J; INTEGER ARRAY FONT[0:FSIZE];
STRING FNTNMS;
FCACHE(FONT[0],FSIZE);
FNTOPN(0,"GACS25.FNT[XGP,SYS]",FHD[0,0]); comment select the default font;
CHAN←GETCHAN; START_CODE TTCALL '10,0; END; comment RESCAN to read command line;
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
WHILE LENGTH(S)≠0 ∧ S[1 TO 1]≠";" DO S←S[2 TO ∞];
IF LENGTH(S)>0 THEN S←S[2 TO ∞] ELSE
BEGIN PRINT("Type ?<cr> for help"); CRLF; CRLF; END;
DO
BEGIN
STRING SF;
IF LENGTH(S)=0 THEN
BEGIN
FILNM; IF HELPACT THEN FIRST3; PRINT(":");
TTYUP(TRUE); S←INCHWL; TTYUP(FALSE);
END;
SF←""; WHILE LENGTH(S)>0 ∧ S[1 TO 1]≠"/" DO SF←SF&LOP(S);
EOF←TRUE;
IF SF="?" THEN BEGIN HELPACT←TRUE; HELPER; END ELSE
BEGIN "FILE"
PRSFIL(""); PRSFIL(".XGP"); PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "FILE";
IF EOF THEN
BEGIN "EOF"
PRSFIL(""); PRSFIL(SF);
OPEN(CHAN,DEVPRS,0,19,0,500,FOO,EOF);
LOOKUP(CHAN,FILPRS,EOF);
END "EOF";
IF EOF THEN S←"";
END UNTIL ¬EOF;
BEGIN
STRING FOO,FN2;
FILDEF(FOO,FOO,FN2,FOO,FOO);
XGP←(FN2="XGP");
END;
IF LENGTH(S)>0 THEN BEGIN STRING SS; SWITCHES(SS←S); END;
IF XGP THEN AUTOCR←FALSE; comment don't break at EOL in XGP files;
NUMCH←0; TXTPNT←POINT(7,DBUF,-1);
LASTFF←0; PNS[0]←(0 LSH 29) LOR (0 LSH 22) LOR 0;
IF XGP THEN
BEGIN
INTEGER NX;
SPOOLF←"XS "&DEVPRS&":"&FILPRS&"/NOHEAD"&'15&'12;
SWT←"";
WHILE (NX←NXCH)≠'14 DO IF ¬(NX='15∨NX='12∨NX=" ") THEN SWT←SWT&NX;
SWITCHES(SWT); comment parse switches in the file;
IF LMAR=50∧PMAR=0 THEN BEGIN LMAR←120; TMAR←120; END; comment TEX defaults;
IF LMAR=0 THEN LMAR←150; comment LMAR=0, PUB default;
IF PMAR=0 THEN PMAR←2200-TMAR-BMAR; comment can't support indefinite pages;
PNS[0]←(0 LSH 29) LOR (0 LSH 22) LOR NUMCH;
END;
FNTN←PNS[0] LSH -29; FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←(PNS[0] LSH -22) LAND '177;
IF LENGTH(S)>0 THEN SWITCHES(S);
comment parse any spooler style switches in the command line;
OWNCH←SYNMAP(2)<0;
IF DENS=0 THEN DENS←(IF OWNCH THEN "H" ELSE "F");
IF OWNCH ∨ ¬(DENS="H"∨DENS="F"∨DENS="D") THEN
BEGIN INTEGER I; FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
IF DENS="H" ∨ DENS="F" ∨ DENS="D" THEN
BEGIN PRINT("<3 synthesizer channels; output will be on your screen"); CRLF; END;
END;
FPN←1; FPNR←0; S←""; PN←2;
IF ¬SPOOLFLAG∧¬NODPY THEN BEGIN
PRINT(IF DENS="B" THEN "bitwise resolution" ELSE
IF DENS="E" THEN "enormous resolution" ELSE
IF DENS="T" THEN "transposed bitwise resolution" ELSE
IF DENS="F" THEN "full density"
ELSE IF DENS="H" THEN "half density"
ELSE "double density"); CRLF; END;
WHILE TRUE DO
BEGIN "DENSITY"
XCMP←IF DENS="B"∨DENS="T"∨DENS="E" THEN 1 ELSE IF DENS="D" THEN 6 ELSE 3;
YCMP←IF DENS="B"∨DENS="T"∨DENS="E" THEN 1 ELSE IF DENS="H" THEN 2 ELSE 4;
BEGIN "PICTURE"
INTEGER HI,WI,BI;
SAFE INTEGER ARRAY PIC[0:PIXDIM(HI←IF DENS="B" THEN TMAR+PMAR+BMAR ELSE
IF DENS="T" THEN RMAR ELSE 481,
WI←IF DENS="B" THEN RMAR+36 ELSE
IF DENS="T" THEN TMAR+PMAR+BMAR+36 ELSE 512,
BI←IF DENS="H" THEN 3
ELSE IF DENS="F" THEN 4
ELSE IF DENS="D" THEN 5
ELSE 1)];
MAKPIX(HI,WI,BI,PIC[0]);
IF ¬OWNCH THEN
BEGIN
INTEGER NCHN; NCHN←0;
FOR I←0 STEP 1 UNTIL PIC[BYBI]-1 DO
IF SYNMAP(I)>0 THEN NCHN←NCHN+1;
IF NCHN<PIC[BYBI] THEN
BEGIN
IF NCHN=0 THEN PRINT("No synthesizer channels.") ELSE
PRINT(PIC[BYBI]-NCHN," synthesizer channel",
IF PIC[BYBI]-NCHN=1 THEN "" ELSE "s"," too few.");
CRLF;
END;
END;
DO
BEGIN "PAGES"
INTEGER FOO;
IF ¬SPOOLFLAG THEN
IF DENS="D" THEN
BEGIN PRINT("FIRST PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END
ELSE IF DENS="F" ∨ DENS="B" ∨ DENS="E" THEN
BEGIN PRINT("PAGE #"); IF HELPACT THEN FIRST; PRINT(":"); END
ELSE
BEGIN PRINT("PAGE"); IF HELPACT THEN BEGIN FIRST1; FIRST; END; PRINT(":"); END;
TTYUP(TRUE); S←GETINCHWL; TTYUP(FALSE);
IF LENGTH(S)=0 THEN
BEGIN
INTEGER IPN;
IPN←FPN;
FPNR←FPN-IPN;
FPN←IPN;
PAGE←TRUE;
END
ELSE IF (S LAND '137)="L" THEN
BEGIN
INTEGER I;
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
IF LENGTH(S)≤1 THEN BEGIN LISTLO←1;
LISTHI←(IF EOF THEN LASTFF+1 ELSE 9999); END
ELSE
BEGIN
I←LOP(S); WHILE LENGTH(S)>0∧(S="("∨S=" ") DO I←LOP(S);
LISTLO←INTSCAN(S,FOO);
WHILE LENGTH(S)>0∧(S=":"∨S=" ") DO I←LOP(S);
LISTHI←IF S="*" THEN 9999 ELSE INTSCAN(S,FOO);
IF LISTHI=0 THEN LISTHI←LISTLO;
END;
IF ¬SPOOLFLAG THEN
PRINT("listing ",LISTLO,":",
IF LISTHI=9999 THEN "*" ELSE CVS(LISTHI)," ..."); CRLF;
SDENS←DENS;
IF DENS≠"T" THEN DENS←"B";
PN←-1;
SPOOLFLAG←"L";
SPOOLF←"";
PAGE←FALSE;
END
ELSE IF S="/" THEN
BEGIN
SWITCHES(S);
PN←-1;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="X" THEN
BEGIN
IF DENS="E" THEN
BEGIN
OUTSTR("White on black?");
SCREEN(0,0,1,1); DDINIT; LITEN;
IF (INCHWL LAND '137)="Y" THEN RECTAN(0,0,1,1);
VIDONE(PIC[0],'77);
OUTSTR("SIZE(-5 to 5):");
FOR I←1 STEP 1 UNTIL NCOPY DO XGPUP(CVD(INCHWL));
END
ELSE
IF NOQUE THEN
IF DENS="B" THEN VIDXGP(PIC[0],YOFF+YSHIFT,
XOFF+XSHIFT,TMAR+PMAR+BMAR-J,NCOPY) ELSE
IF DENS="T" THEN VIDXGP(PIC[0],0,YOFF,RMAR,NCOPY)
ELSE VIDXGP(PIC[0],0,0,PIC[PCLN],NCOPY)
ELSE
IF DENS="B" THEN VIDXGQ(PIC[0],YOFF+YSHIFT,
XOFF+XSHIFT,TMAR+PMAR+BMAR-J,NCOPY) ELSE
IF DENS="T" THEN VIDXGQ(PIC[0],0,YOFF,RMAR,NCOPY)
ELSE VIDXGQ(PIC[0],0,0,PIC[PCLN],NCOPY);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="V" THEN
BEGIN
INTEGER I,J;
BEGIN
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF DENS="B"∨DENS="T"∨OWNCH
THEN 0 ELSE DDSIZ];
DDINIT;
IF ¬OWNCH THEN
BEGIN
GRAY(PIC[0]);
MAPGRY(IF DENS="D" THEN 1.5 ELSE 1,PIC[BYBI],TRUE);
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
CASE PIC[BYBI] OF
BEGIN
[1] VID1(PIC[0],DBUF);
[3] VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF);
[4] VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
[5] VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF)
END;
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
PRINT(" DONE"); CRLF;
UNGRAY(PIC[0]);
END
ELSE
BEGIN
VIDONE(PIC[0],IF PIC[BYBI]>2 THEN '7776 ELSE '7777);
DPYUP(-1); DPYUP(-1);
CALL(0,"SNEAKW"); comment don't wipe out screen right away;
END;
END;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="P" THEN
BEGIN comment normal picture file;
PRINT("OUTPUT FILE NAME:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PUTPFL(PIC[0],INCHWL);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="O" THEN
BEGIN comment compressed output file;
PRINT("OUTPUT FILE NAME:");
PRSFIL("↓↓:↓↓.↓↓[↓↓,↓↓]");
PUTPFL(PIC[0],INCHWL,2);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="K" THEN
BEGIN
INTEGER I;
IF OWNCH THEN ERASE(-1) ELSE MAPGRY(-1,0,TRUE);
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
PAGE←FALSE;
END
ELSE IF (S LAND '137)="Q" THEN
BEGIN
IF DENS≠"B"∧DENS≠"T" THEN LODED(SPOOLF);
CALL(0,"EXIT");
PAGE←FALSE;
END
ELSE IF (S LAND '137)="W" THEN
BEGIN
WHITELET←¬WHITELET;
IF WHITELET THEN PRINT("White letters on black")
ELSE PRINT("Black letters on white");
CRLF;
BEGIN
INTEGER I,J,K;
INTEGER ARRAY TRANS[0:PIC[BMAX]];
J←PIC[BMAX]; K←J-(J LSH -1);
FOR I←0 STEP 1 UNTIL J DO
TRANS[I]←I XOR K;
PERBIT(PIC[0],TRANS[0]);
END;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="C" THEN
BEGIN
INTEGER I;
OWNCH←TRUE;
PRINT("on your display"); CRLF;
PRINT("half density"); DENS←"H"; CRLF;
FOR I←'30 STEP 1 UNTIL '37 DO RDDCHN(I);
PN←-1;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="S" THEN
BEGIN
OWNCH←FALSE;
PRINT("on video synthesizer"); CRLF;
MAPGRY(1,1,TRUE);
PAGE←FALSE;
END
ELSE IF S="?" THEN
BEGIN
HELPACT←TRUE;
HELPER;
PAGE←FALSE;
END
ELSE IF (S LAND '137)="B" ∨ (S LAND '137)="T" ∨ (S LAND '137)="F"
∨ (S LAND '137)="D" ∨ (S LAND '137)="H" ∨ (S LAND '137)="E" THEN
BEGIN
S←S LAND '137;
PRINT(IF S="B" THEN "bitwise resolution" ELSE
IF S="E" THEN "enormous resolution" ELSE
IF S="T" THEN "transposed bitwise resolution" ELSE
IF S="F" THEN "full density"
ELSE IF S="H" THEN "half density"
ELSE "double density"); CRLF;
DENS←S;
PN←-1;
PAGE←FALSE;
END
ELSE
BEGIN
INTEGER IPN;
FPN←REALSCAN(S,FOO);
IPN←FPN;
FPNR←FPN-IPN+ABS(REALSCAN(S,FOO));
FPN←IPN;
PAGE←TRUE;
END;
IF PAGE THEN BEGIN PN←FPN; SETOFFSET; END;
IF PAGE ∧ PN>0 THEN
BEGIN "NONZERO"
IF EOF ∨ PN≠LASTFF+1 THEN
BEGIN
INTEGER PNSLASTFF;
LASTFF←PN-1;
LASTFF←LASTFF MIN PAGEMAX;
WHILE LASTFF>0 ∧ PNS[LASTFF]=-1 DO LASTFF←LASTFF-1;
PNSLASTFF←PNS[LASTFF] LAND '17777777;
EOF←FALSE;
USETI(CHAN,1+PNSLASTFF%('200*5));
EOF←EOF ∨ PNSLASTFF≥LASTUSETI;
INSTR←""; NUMCH←(PNSLASTFF%('200*5))*'200*5;
FOR I←(PNSLASTFF MOD ('200*5)) STEP -1 UNTIL 1 DO NXCH;
FNTN←PNS[LASTFF] LSH -29;
FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←(PNS[LASTFF] LSH -22) LAND '177;
END;
WIPE(PIC[0],0);
comment assemble line of text;
XPOS←LMAR; YPOS←TMAR;
BASE←0;
WHILE ¬EOF ∧ LASTFF<(IF DENS="D" THEN PN+1 ELSE PN) DO
BEGIN "NOTEOF"
DEFINE INF=10000000;
INTEGER I,J,LC,YU,YL;
YU←-INF; YL←INF;
PRNT←LASTFF≥PN-1;
IF DENS="D" ∧ LASTFF=PN THEN
XOFF←(((LMAR-20) MIN (RMAR-3*512))MAX -10)-512*3;
IF DENS="D" ∧ LASTFF≠PN THEN
XOFF←((LMAR-20) MIN (RMAR-3*512)) MAX -10;
comment calculate height of line;
SBASE←BASE; SFNTN←FNTN; XPOS←LMAR; SINTERCHAR←INTERCHAR;
TXTPNT←POINT(7,DBUF,-1); DUN←FALSE; LINLEN←0;
IFC MAXESCAPE>0 THENC ESCHIT←0; NESCAPE←0; ENDC
WHILE ¬DUN∧¬EOF DO
BEGIN "HEIGHT"
CASE PN1←NXCH OF
BEGIN
[0] QUICK_CODE SETO 1,; IBP 1,TXTPNT; comment ADJBP;
MOVEM 1,TXTPNT; END;
['177] CASE PN2←NXCH OF
BEGIN
['1] CASE PN3←NXCH OF
BEGIN
[0][1][2][3][4][5][6][7][8]
[9][10][11][12][13][14][15]
BEGIN
FNTN←PN3;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
['43] BASE←((NXCH LSH 29) ASH -29);
['52] BASE←BASE+((NXCH LSH 29) ASH -29);
['40] XPOS←NXCH*128+NXCH;
['41]
BEGIN
YU←YU MAX (((PN4←NXCH) LSH 29) ASH -29);
YL←YL MIN ((PN4 LSH 29) ASH -29);
XPOS←XPOS+NXCH*128+NXCH;
END;
['42] BEGIN
IF YL=INF THEN YL←-FTB-BASE;
IF YU=-INF THEN YU←FTH-BASE-FTB; NXCH;
DUN←TRUE; END;
['44] ;
['45] FOR I←NXCH STEP -1 UNTIL 1 DO NXCH;
['46] ;
['47]
BEGIN
INTEGER YP;
YP←((NXCH LSH 29) ASH -29);
YU←YU MAX YP; YL←YL MIN YP;
END;
['50] INTERCHAR←NXCH;
['51]
BEGIN
INTEGER YP;
PN4←NXCH;
YP←((NXCH LSH 29) ASH -29);
YU←YU MAX (YP+PN4); YL←YL MIN YP;
END;
ELSE
END;
[2] XPOS←XPOS+((NXCH LSH 29) ASH -29);
[3] YPOS←NXCH*128+NXCH;
[4] FOR I←1 STEP 1 UNTIL 11 DO NXCH;
[5]
BEGIN
FNTN←NXCH;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
[6]
BEGIN
INTEGER PREVHT;
PREVHT←BASE+FTB;
FNTN←NXCH;
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←(IF LINLEN=0 THEN 0 ELSE PREVHT-FTB);
END;
[7]['10]['13]
['16]['17]['20]['21]['22]['23]['24]['25]['26]
['27]['30]['31]['32]['33]['34]['35]['36]['37] ;
ELSE
IF (XPOS+(FHD[FNTN,PN2] LSH -18)+INTERCHAR+UINTERCHAR)
≤RMAR ∨ ¬AUTOCR THEN
BEGIN
IFC MAXESCAPE>0 THENC
IF ESCHIT<LENGTH(ESCAPE) THEN
IF PN2=ESCAPE[ESCHIT+1 FOR 1] THEN
BEGIN
ESCHIT←ESCHIT+1;
IF ESCHIT=1 THEN
BEGIN
ESCX[NESCAPE+1]←XPOS;
ESCY[NESCAPE+1]←-FHD[FNTN,FNTBAS]%2-BASE;
ESCF[NESCAPE+1]←BYT(TXTPNT);
END;
IF ESCHIT=LENGTH(ESCAPE) THEN
BEGIN
NESCAPE←NESCAPE+1;
ESCX[NESCAPE]←(ESCX[NESCAPE]+XPOS
+(FHD[FNTN,PN2] LSH -18)
+INTERCHAR+UINTERCHAR)%2;
ESCY[NESCAPE]←(ESCY[NESCAPE]-
FHD[FNTN,FNTBAS]%2-BASE)%2;
ESCL[NESCAPE]←BYT(TXTPNT);
ESCCOM[NESCAPE]←"";
IF (NESCAPE LAND 1)=0 THEN ESCCOM[NESCAPE-1]←
ESCCOM[NESCAPE-1][2 TO ∞-LENGTH(ESCAPE)+1];
ESCHIT←0;
END;
END
ELSE ESCHIT←0;
IF (NESCAPE LAND 1)=1 THEN
ESCCOM[NESCAPE]←ESCCOM[NESCAPE]&PN2;
ENDC
XPOS←XPOS+(FHD[FNTN,PN2] LSH -18)+INTERCHAR+UINTERCHAR;
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
LINLEN←LINLEN+1;
END
ELSE DUN←TRUE
END;
['15] XPOS←LMAR;
['11]
BEGIN
INTEGER BLANW;
BLANW←(FHD[FNTN," "] LSH -18)+INTERCHAR+UINTERCHAR;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
LINLEN←LINLEN+1;
END;
ELSE
IF (XPOS+(FHD[FNTN,PN1] LSH -18)+INTERCHAR+UINTERCHAR)≤RMAR
∨ ¬AUTOCR THEN
BEGIN
IFC MAXESCAPE>0 THENC
IF ESCHIT<LENGTH(ESCAPE) THEN
IF PN1=ESCAPE[ESCHIT+1 FOR 1] THEN
BEGIN
ESCHIT←ESCHIT+1;
IF ESCHIT=1 THEN
BEGIN
ESCX[NESCAPE+1]←XPOS;
ESCY[NESCAPE+1]←-FHD[FNTN,FNTBAS]%2-BASE;
ESCF[NESCAPE+1]←BYT(TXTPNT);
END;
IF ESCHIT=LENGTH(ESCAPE) THEN
BEGIN
NESCAPE←NESCAPE+1;
ESCX[NESCAPE]←(ESCX[NESCAPE]+XPOS
+(FHD[FNTN,PN1] LSH -18)
+INTERCHAR+UINTERCHAR)%2;
ESCY[NESCAPE]←(ESCY[NESCAPE]-
FHD[FNTN,FNTBAS]%2-BASE)%2;
ESCL[NESCAPE]←BYT(TXTPNT);
ESCCOM[NESCAPE]←"";
IF (NESCAPE LAND 1)=0 THEN ESCCOM[NESCAPE-1]←
ESCCOM[NESCAPE-1][2 TO ∞-LENGTH(ESCAPE)+1];
ESCHIT←0;
END;
END
ELSE ESCHIT←0;
IF (NESCAPE LAND 1)=1 THEN
ESCCOM[NESCAPE]←ESCCOM[NESCAPE]&PN1;
ENDC
XPOS←XPOS+(FHD[FNTN,PN1] LSH -18)+INTERCHAR+UINTERCHAR;
LINLEN←LINLEN+1;
IF PN1='12 ∨ PN1='14 THEN
BEGIN
IF PN1='14 THEN
BEGIN
LASTFF←LASTFF+1;
IF LASTFF≤PAGEMAX THEN
PNS[LASTFF]←(FNTN LSH 29) LOR
(INTERCHAR LSH 22) LOR NUMCH;
PRINT(LASTFF," ");
END;
DUN←TRUE;
END
ELSE
BEGIN
YU←YU MAX (FTH-BASE-FTB); YL←YL MIN (-FTB-BASE);
END;
END
ELSE DUN←TRUE
END;
END "HEIGHT";
IF YL=INF THEN YL←-FTB-BASE; IF YU=-INF THEN YU←FTH-BASE-FTB;
BASE←SBASE;
FNTN←SFNTN; FTH←FHD[FNTN,FNTHIG]; FTB←FHD[FNTN,FNTBAS];
INTERCHAR←SINTERCHAR;
comment assemble line;
IF PRNT THEN
BEGIN "ASSEMBLE"
IFC MAXESCAPE>0 THENC
FOR I←2 STEP 2 UNTIL NESCAPE DO IF LENGTH(ESCCOM[I-1])>0 THEN
BEGIN "ESCAPE CODE INTERPRETER"
INTEGER J,K,X0,Y0,ESCC; STRING COM;
COM←ESCCOM[I-1]; ESCCOM[I-1]←"";
X0←(ESCX[I]+ESCX[I-1])%2; Y0←(ESCY[I]+ESCY[I-1])%2+YPOS-YL;
CASE (ESCC←LOP(COM)) OF
BEGIN
["G"]["L"]["P"] BEGIN "GRAPHICS ESCAPE"
INTEGER XZ,YZ,XPL,YPL,XPH,YPH, PICN; INTEGER ARRAY TSP[1:1], TIDINGS[1:32];
INTEGER TP; INTEGER XPLO,YPLO,LWC,XO,YO;
PROCEDURE PI(INTEGER I); TIDINGS[TP←TP+1]←I;
PROCEDURE PR(REAL R); MEMORY[LOCATION(TIDINGS[TP←TP+1]),REAL]←R;
PROCEDURE PS(STRING S);
BEGIN INTEGER I,L; PI(L←LENGTH(S)); L←(L+4)%5;
FOR I←1 STEP 1 UNTIL L DO BEGIN PI(CVASC(S)); IF I≠L THEN S←S[6 TO ∞]; END; END;
XO←YO←XPLO←YPLO←LWC←0; comment plotter pos, offsets, wrd cnt, for "L" mode;
PICN←0; IF COM≥"0" ∧ COM≤"9" THEN PICN←INTSCAN(COM,K);
IF ESCC="L" THEN BEGIN XZ←1700; YZ←2200; END
ELSE BEGIN XZ←1200; YZ←900; END;
IF COM="[" THEN BEGIN K←LOP(COM);
IF COM≠"%" THEN X0←8.5*200/2 ELSE K←LOP(COM);
IF COM≠"," THEN X0 ← X0+REALSCAN(COM,K)*200; IF COM="," THEN K←LOP(COM);
IF COM≠"%" THEN Y0 ← 11*200/2 ELSE K←LOP(COM);
IF COM≠"]" THEN Y0 ← Y0-REALSCAN(COM,K)*200;
IF LOP(COM)≠"]" THEN PRINT("graphics escape syntax error ",COM,'15&'12); END;
IF COM="(" THEN BEGIN XZ←REALSCAN(COM,K)*200; YZ←REALSCAN(COM,K)*200;
IF LOP(COM)≠")" THEN PRINT("graphics escape syntax error ",COM,'15&'12); END;
DO UNTIL LENGTH(COM)=0 ∨ LOP(COM)=":";
IF ESCC="L" THEN Y0←Y0-YZ%2+YZ%10;
BEGIN
INTEGER ARRAY DIA[0:IF DENS="B"∨DENS="E"∨DENS="T" THEN 0 ELSE
IF DENS="H"∨DENS="D" THEN PIXDIM(YZ+YCMP-1,XZ+XCMP-1,1) ELSE
IF DENS="F" THEN PIXDIM(XZ+XCMP-1,YZ+YCMP-1,1) ELSE 0];
CASE DENS OF
BEGIN
["B"]["E"] PDDINI(PIC[0],YPL←Y0-YZ%2-YOFF,XPL←X0-XZ%2-XOFF,
YPH←Y0-YZ%2-YOFF+YZ-1,XPH←X0-XZ%2-XOFF+XZ-1);
["H"]["D"] BEGIN MAKPIX(YZ+YCMP-1,XZ+XCMP-1,1,DIA[0]);
PDDINI(DIA[0],YPL←0,XPL←0,YPH←YZ-1,XPH←XZ-1); END;
["T"] PDDINI(PIC[0],PIC[PCLN]-(XPH←(X0-XZ%2-XOFF+XZ-1)),YPL←Y0-YZ%2-YOFF,
PIC[PCLN]-(XPL←(X0-XZ%2-XOFF)),YPH←Y0-YZ%2-YOFF+YZ-1);
["F"] BEGIN MAKPIX(XZ+XCMP-1,YZ+YCMP-1,1,DIA[0]);
PDDINI(DIA[0],XPL←0,YPL←0,XPH←XZ-1,YPH←YZ-1); END
END;
PLITEN;
CASE DENS OF
BEGIN
["B"]["E"]["H"]["D"] BEGIN PSCREE(0,0,1,1); PTXTPO(0,0,1/70,1/35,0,0); END;
["F"]["T"] BEGIN PSCREE(1,0,0,1); PTXTPO(0,0,0,0,1/35,1/70); END
END;
BEGIN "PICJOB"
INTEGER CONTROL,CONTROLNAM,CMD,NFILE,BRCHAR,EOF,T,FLAG;
INTEGER ARRAY CHANS[0:16];
PROCEDURE RCVMESS;
comment get the next command from file;
BEGIN
IF TSP[1]=0 THEN RETURN; TSP[1]←0;
IF CHANS[NFILE]<0 THEN EOF←TRUE ELSE
BEGIN IF EOF THEN BEGIN RELEASE(CHANS[NFILE]); EOF←FALSE; NFILE←NFILE-1;
IF CHANS[NFILE]=-2 THEN EOF←TRUE; END;
IF ¬EOF THEN
BEGIN
IF ESCC="L" THEN
BEGIN INTEGER I;
TP←0;
DO BEGIN IF LWC='200 THEN BEGIN WORDIN(CHANS[NFILE]); LWC←1; END;
I←WORDIN(CHANS[NFILE]); LWC←LWC+1;
IF (I LAND '377)=3 THEN
BEGIN XO←(I ASH -22)+XPLO; YO←((I LSH 14) ASH -22)+YPLO; END
ELSE IF (I LAND '377)='375 THEN
BEGIN XPLO←(I ASH -22)+XPLO; YPLO←((I LSH 14) ASH -22)+YPLO; END;
END UNTIL EOF ∨ (I LAND '377)=2;
IF ¬EOF ∧ (I LAND '377)=2 THEN BEGIN "LINE" INTEGER XA,YA;
PI(LINE_); PR(XA←XO); PR(YA←YO); XO←(I ASH -22)+XPLO;
YO←((I LSH 14) ASH -22)+YPLO; PR(XO); PR(YO); PI(THIK);
END "LINE";
PI(MARK_);
END
ELSE ARRYIN(CHANS[NFILE],TIDINGS[1],32);
END;
END;
END;
PROCEDURE MARKMESS; BEGIN RCVMESS; END;
REAL PROCEDURE GETREAL;
BEGIN
IF TSP[1]=32 THEN RCVMESS;
TSP[1]←TSP[1]+1;
RETURN(MEMORY[LOCATION(TIDINGS[TSP[1]]),REAL]);
END;
INTEGER PROCEDURE GETINT;
BEGIN
IF TSP[1]=32 THEN RCVMESS;
TSP[1]←TSP[1]+1;
RETURN(TIDINGS[TSP[1]]);
END;
STRING PROCEDURE GETSTRING;
BEGIN
INTEGER I,L,LL; STRING V;
LL←GETINT; L←(LL+4)%5; V←"";
FOR I←1 STEP 1 UNTIL L DO V←V&CVSTR(GETINT);
RETURN(V[1 TO LL]);
END;
PROCEDURE GETINTARRAY(REFERENCE INTEGER AR; INTEGER N);
BEGIN
INTEGER I;
FOR I←0 STEP 1 UNTIL N-1 DO MEMORY[LOCATION(AR)+I]←GETINT;
END;
CHANS[0]←-2;
IF ESCC="G"∨ESCC="L" THEN
BEGIN
NFILE←1; CHANS[NFILE]←GETCHAN;
PRSFIL(""); PRSFIL(COM);
OPEN(CHANS[NFILE],DEVPRS,8,19,0,1,BRCHAR,EOF);
LOOKUP(CHANS[NFILE],FILPRS,FLAG);
IF FLAG THEN BEGIN PRINT(" Graphics file ",COM," not found"&'15&'12); EOF←TRUE;
RELEASE(CHANS[NFILE]); END;
IF ESCC="L" THEN
BEGIN TP←0; PI(SCREEN_); PR(-XZ/2); PR(-YZ%10); PR(XZ/2); PR(YZ-YZ%10);
PI(LITEN_); PI(MARK_); END;
END
ELSE IF ESCC="P" THEN
BEGIN
NFILE←0; TSP[1]←0; EOF←FALSE; TP←0;
PI(SCREEN_); PR(0); PR(0); PR(1); PR(1);
PI(IF (PICN LAND 1)=0 THEN PICFIL_ ELSE PICFIT_);
PR(IF (PICN LAND 4)=0 THEN 0 ELSE 1); PR(IF (PICN LAND 2)=0 THEN 0 ELSE 1);
PR(IF (PICN LAND 4)=0 THEN 1 ELSE 0); PR(IF (PICN LAND 2)=0 THEN 1 ELSE 0);
PS(COM); IF TP<32 THEN PI(MARK_);
END;
WHILE ¬EOF DO
BEGIN "GRAPHICS"
OWN REAL FXP,FYP, FXS,FYS,FDXS,FDYS;
CMD←GETINT;
CASE CMD OF
BEGIN
[KILJOB_]
BEGIN EOF←TRUE; IF CHANS[NFILE]=-2 THEN DONE "GRAPHICS" ELSE MARKMESS; END;
[DISOWN_] CHANS[0]←-2;
[MARK_] MARKMESS;
[GRAFIL_]
BEGIN
EOF←FALSE;
IF (CHANS[NFILE←NFILE+1]←GETCHAN)<0 THEN EOF←TRUE
ELSE
BEGIN
PRSFIL(""); PRSFIL(GETSTRING);
OPEN(CHANS[NFILE],DEVPRS,8,19,0,1,BRCHAR,EOF);
LOOKUP(CHANS[NFILE],FILPRS,FLAG);
IF FLAG THEN EOF←TRUE;
END;
MARKMESS;
END;
[DDINIT_] ;
[SCREEN_]
BEGIN
REAL XL,YL,XH,YH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PSCREE(XL,YL,XH,YH);
["F"]["T"] PSCREE(YH,XL,YL,XH) END;
END;
[DRKEN_] PDRKEN;
[LITEN_] PLITEN;
[INVEN_] PINVEN;
[DOT_] BEGIN REAL X,Y; INTEGER TH; X←GETREAL; Y←GETREAL; TH←GETINT;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PDOT(X,Y,TH); ["F"]["T"] PDOT(Y,X,TH) END;
END;
[LINE_]
BEGIN
REAL XL,YL,XH,YH; INTEGER TH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL; TH←GETINT;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PLINE(XL,YL,XH,YH,TH);
["F"]["T"] PLINE(YL,XL,YH,XH,TH) END;
END;
[RECTAN_]
BEGIN
REAL XL,YL,XH,YH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PRECTA(XL,YL,XH,YH);
["F"]["T"] PRECTA(YL,XL,YH,XH) END;
END;
[ELLIPS_]
BEGIN
REAL XL,YL,XH,YH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PELLIP(XL,YL,XH,YH);
["F"]["T"] PELLIP(YL,XL,YH,XH) END;
END;
[POLYGO_]
BEGIN
INTEGER N,I;
REAL ARRAY X,Y[1:N←GETINT];
FOR I←1 STEP 1 UNTIL N DO
BEGIN X[I]←GETREAL; Y[I]←GETREAL; END;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PPOLYG(N,X[1],Y[1]);
["F"]["T"] PPOLYG(N,Y[1],X[1]) END;
END;
[TXTPOS_]
BEGIN
REAL XL,YL,XS,YS,DXS,DYS;
XL←GETREAL; YL←GETREAL; XS←GETREAL; YS←GETREAL; DXS←GETREAL; DYS←GETREAL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PTXTPO(XL,YL,XS,YS,DXS,DYS);
["F"]["T"] PTXTPO(YL,XL,DYS,DXS,YS,XS) END;
END;
[TEXT_] PTEXT(GETSTRING);
[TEXTD_] PTEXTD(GETSTRING);
[FNTSEL_] BEGIN
INTEGER F; STRING FNTNAM;
F←GETINT; FNTNAM←GETSTRING;
IF FHD[F,FNTHIG]=-1 THEN
BEGIN
PRSFIL(""); PRSFIL(".FNT[XGP,SYS]");
WHILE FNTOPN(F,FNTNAM,FHD[F,0])<0 DO
BEGIN
PRINT("COULDN'T GET ",DEVPRS,":",FILPRS); CRLF;
PRINT("Try again:");
PRSFIL(""); PRSFIL(".FNT[XGP,SYS]");
FNTNAM←INCHWL;
END;
END;
END;
[FNTPOS_] BEGIN
REAL TX,TY; REAL XL,YL,XH,YH;
PSCREM(XL,YL,XH,YH);
IF DENS="F"∨DENS="T" THEN BEGIN XL↔YL; XH↔YH; YL↔YH; END;
TX←GETREAL; TY←GETREAL;
FXP←XPL+(XPH-XPL)*(TX-XL)/(XH-XL);
FYP←YPH+(YPL-YPH)*(TY-YL)/(YH-YL);
FXS←GETREAL; FYS←GETREAL;
FDXS←GETREAL; FDYS←GETREAL;
END;
[FNTEXT_] BEGIN
INTEGER XP,YP,CH,FNT; STRING TXT;
XP←GETREAL; YP←GETREAL;
FNT←GETINT; TXT←GETSTRING;
WHILE LENGTH(TXT)>0 DO
BEGIN
CH←LOP(TXT);
CASE DENS OF
BEGIN
["H"]["D"] CHRTRN(FNT,CH,DIA[0],FYP-YP*FYS-XP*FDYS,
FXP+XP*FXS+YP*FDXS,FXS,FYS,FDXS,FDYS);
["B"]["E"] CHRTRN(FNT,CH,PIC[0],FYP-YP*FYS-XP*FDYS,
FXP+XP*FXS+YP*FDXS,FXS,FYS,FDXS,FDYS);
["T"] CHRTRN(FNT,CH,PIC[0],PIC[PCLN]-1-(FXP+XP*FXS+YP*FDXS),
FYP-YP*FYS-XP*FDYS,-FDYS,FDXS,-FYS,FXS);
["F"] CHRTRN(FNT,CH,DIA[0],DIA[PCLN]-1-(FXP+XP*FXS+YP*FDXS),
FYP-YP*FYS-XP*FDYS,-FDYS,FDXS,-FYS,FXS)
END;
XP←XP+(FHD[FNT,CH] LSH -18);
END;
END;
[FNTDOT_] BEGIN REAL X,Y; REAL XL,YL,XH,YH,DX,DY; INTEGER I,TH;
X←GETREAL; Y←GETREAL; TH←GETINT;
X←XL; Y←YL;
PSCREM(XL,YL,XH,YH);
IF DENS="F"∨DENS="T" THEN BEGIN XL↔YL; XH↔YH; YL↔YH; END;
DX←FXP+X*FXS+Y*FDXS; DY←FYP-Y*FYS-X*FDYS;
X←(DX-XPL)*(XH-XL)/(XPH-XPL)+XL;
Y←(DY-YPH)*(YH-YL)/(YPL-YPH)+YL;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PDOT(X,Y,TH);
["F"]["T"] PDOT(Y,X) END;
END;
[FNTLIN_] BEGIN REAL ARRAY X,Y[1:2]; REAL XL,YL,XH,YH,DX,DY,D; INTEGER I,TH;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL; TH←GETINT;
DX←XH-XL; DY←YH-YL; D←SQRT(DX↑2+DY↑2);
X[1]←XL; Y[1]←YL; X[2]←XH; Y[2]←YH;
PSCREM(XL,YL,XH,YH);
IF DENS="F"∨DENS="T" THEN BEGIN XL↔YL; XH↔YH; YL↔YH; END;
FOR I←1 STEP 1 UNTIL 2 DO
BEGIN DX←FXP+X[I]*FXS+Y[I]*FDXS; DY←FYP-Y[I]*FYS-X[I]*FDYS;
X[I]←(DX-XPL)*(XH-XL)/(XPH-XPL)+XL;
Y[I]←(DY-YPH)*(YH-YL)/(YPL-YPH)+YL; END;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PLINE(X[1],Y[1],X[2],Y[2],TH);
["F"]["T"] PLINE(Y[1],X[1],Y[2],X[2],TH) END;
END;
[FNTREC_] BEGIN REAL ARRAY X,Y[1:4]; REAL XL,YL,XH,YH,DX,DY; INTEGER I;
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL;
X[1]←XL; Y[1]←YL; X[2]←XL; Y[2]←YH; X[3]←XH; Y[3]←YH; X[4]←XH; Y[4]←YL;
PSCREM(XL,YL,XH,YH);
IF DENS="F"∨DENS="T" THEN BEGIN XL↔YL; XH↔YH; YL↔YH; END;
FOR I←1 STEP 1 UNTIL 4 DO
BEGIN DX←FXP+X[I]*FXS+Y[I]*FDXS; DY←FYP-Y[I]*FYS-X[I]*FDYS;
X[I]←(DX-XPL)*(XH-XL)/(XPH-XPL)+XL;
Y[I]←(DY-YPH)*(YH-YL)/(YPL-YPH)+YL; END;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PPOLYG(4,X[1],Y[1]);
["F"]["T"] PPOLYG(4,Y[1],X[1]) END;
END;
[FNTELL_] BEGIN DEFINE NELP=20; PRELOAD_WITH 0; OWN REAL ARRAY S,C[1:NELP];
REAL ARRAY X,Y[1:NELP]; INTEGER I; REAL XL,YL,XH,YH,X1,Y1,X2,Y2,DX,DY;
IF S[1]=0 THEN FOR I←1 STEP 1 UNTIL NELP DO
BEGIN S[I]←SIN(I*3.14159*2/NELP); C[I]←COS(I*3.14159*2/NELP); END;
PSCREM(XL,YL,XH,YH); X1←GETREAL; Y1←GETREAL; X2←GETREAL; Y2←GETREAL;
IF DENS="F"∨DENS="T" THEN BEGIN XL↔YL; XH↔YH; YL↔YH; END;
FOR I←1 STEP 1 UNTIL NELP DO
BEGIN REAL XA,YA;
XA←(X2+X1+C[I]*(X2-X1))/2; YA←(X2+X1+S[I]*(X2-X1))/2;
DX←FXP+XA*FXS+YA*FDXS; DY←FYP-YA*FYS-XA*FDYS;
X[I]←(DX-XPL)*(XH-XL)/(XPH-XPL)+XL;
Y[I]←(DY-YPH)*(YH-YL)/(YPL-YPH)+YL; END;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PPOLYG(NELP,X[1],Y[1]);
["F"]["T"] PPOLYG(NELP,Y[1],X[1]) END;
END;
[FNTPOL_] BEGIN INTEGER NP,I; REAL XL,YL,XH,YH,DX,DY; REAL ARRAY X,Y[1:NP←GETINT];
PSCREM(XL,YL,XH,YH);
FOR I←1 STEP 1 UNTIL NP DO BEGIN X[I]←GETREAL; Y[I]←GETREAL; END;
IF DENS="F"∨DENS="T" THEN BEGIN XL↔YL; XH↔YH; YL↔YH; END;
FOR I←1 STEP 1 UNTIL NP DO
BEGIN DX←FXP+X[I]*FXS+Y[I]*FDXS; DY←FYP-Y[I]*FYS-X[I]*FDYS;
X[I]←(DX-XPL)*(XH-XL)/(XPH-XPL)+XL;
Y[I]←(DY-YPH)*(YH-YL)/(YPL-YPH)+YL; END;
CASE DENS OF BEGIN
["H"]["D"]["E"]["B"] PPOLYG(NP,X[1],Y[1]);
["F"]["T"] PPOLYG(NP,Y[1],X[1]) END;
END;
[PICFIL_]
BEGIN
REAL XL,YL,XH,YH; STRING FN; BOOLEAN WRKD;
PRSFIL("");
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL; FN←GETSTRING;
CASE DENS OF BEGIN
["H"]["D"] WRKD←PPICHI(XL,YL,XH,YH,FN);
["E"]["B"] WRKD←
(IF VARIAN THEN PPICHI(XL,YL,XH,YH,FN) ELSE PPICFI(XL,YL,XH,YH,FN));
["F"] WRKD←PPICHT(YH,XH,YL,XL,FN);
["T"] WRKD←
(IF VARIAN THEN PPICHT(YH,XH,YL,XL,FN) ELSE PPICFT(YH,XH,YL,XL,FN)) END;
IF ¬WRKD THEN PRINT("Picture file ",FN," not found",'15&'12);
END;
[PICFIT_]
BEGIN
REAL XL,YL,XH,YH; STRING FN; BOOLEAN WRKD;
PRSFIL("");
XL←GETREAL; YL←GETREAL; XH←GETREAL; YH←GETREAL; FN←GETSTRING;
CASE DENS OF BEGIN
["H"]["D"] WRKD←PPICHT(XL,YL,XH,YH,FN);
["B"]["E"] WRKD←
(IF VARIAN THEN PPICHT(XL,YL,XH,YH,FN) ELSE PPICFT(XL,YL,XH,YH,FN));
["F"] WRKD←PPICHI(YL,XL,YH,XH,FN);
["T"] WRKD←
(IF VARIAN THEN PPICHI(YL,XL,YH,XH,FN) ELSE PPICFI(YL,XL,YH,XH,FN)) END;
IF ¬WRKD THEN PRINT("Picture file ",FN," not found",'15&'12);
END;
ELSE
BEGIN
STRING A; INTEGER K,L,M; INTEGER ARRAY INT[1:10];
A←ARG[CMD]; K←0;
WHILE LENGTH(A)>0∧A≠"→" DO
CASE LOP(A) OF
BEGIN
["I"] INT[K←K+1]←GETINT;
["R"] INT[K←K+1]←GETINT;
["S"] GETSTRING;
["A"] BEGIN L←INTSCAN(A,M); FOR M←1 STEP 1 UNTIL INT[L] DO GETINT; END;
ELSE PRINT("bad arg ",CMD,'15&'12)
END;
IF LENGTH(A)>0 ∧ LOP(A)="→" THEN
BEGIN
WHILE LENGTH(A)>0 DO
CASE LOP(A) OF
BEGIN
["I"] ;
["R"] ;
["S"] ;
["A"] ;
ELSE PRINT("bad return ",CMD,'15&'12)
END;
MARKMESS;
END;
END
END;
END "GRAPHICS";
WHILE CHANS[NFILE]>0 DO BEGIN RELEASE(CHANS[NFILE]); NFILE←NFILE-1; END;
END "PICJOB";
CASE DENS OF
BEGIN
["H"]["D"]
SATILE(DIA[0],0,0,(YZ+YCMP-1)%YCMP,(XZ+XCMP-1)%XCMP,YCMP,XCMP,
PIC[0],((Y0-YOFF)-YZ%2)%YCMP,
((X0-XOFF)-XZ%2)%XCMP);
["F"]
SATILE(DIA[0],0,0,(XZ+XCMP-1)%XCMP,(YZ+YCMP-1)%YCMP,XCMP,YCMP,
PIC[0],PIC[PCLN]-XZ%XCMP-((X0-XOFF)-XZ%2)%XCMP,
((Y0-YOFF)-YZ%2)%YCMP);
["B"]["E"]["T"]
END;
END;
END "GRAPHICS ESCAPE";
ENDC
IFC MAXESCAPE>0 THENC
ELSE
FOR J←ESCX[I-1] STEP 1 UNTIL ESCX[I] DO FOR K←-2 STEP 1 UNTIL 2 DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],(Y0-YOFF+K)%YCMP,(J-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],Y0-YOFF+K,J-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(J-XOFF)%XCMP,(Y0-YOFF+K)%YCMP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(J-XOFF),Y0-YOFF+K,1)
END
END;
END "ESCAPE CODE INTERPRETER";
ENDC
IFC MAXESCAPE>0 THENC ESCHIT←1; ENDC
XPOS←LMAR;
FOR I←1 STEP 1 UNTIL 20 DO IDPB(0,TXTPNT);
TXTPNT←POINT(7,DBUF,-1);
YPOS←YPOS-YL;
LINLEN←0;
WHILE ILDB(TXTPNT)>0 DO
BEGIN "ASSLP"
CASE LDB(TXTPNT) OF
BEGIN
[0] ;
['177] CASE ILDB(TXTPNT) OF
BEGIN
['1] CASE ILDB(TXTPNT) OF
BEGIN
[0][1][2][3][4][5][6][7][8]
[9][10][11][12][13][14][15]
BEGIN
FNTN←LDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
['43] BASE←((ILDB(TXTPNT) LSH 29) ASH -29);
['52] BASE←BASE+((ILDB(TXTPNT) LSH 29) ASH -29);
['40]
BEGIN
XPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT);
END;
['41]
BEGIN
INTEGER XP,YP,XNEW;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
XNEW←XPOS+ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR XP←XPOS STEP 1 UNTIL XNEW DO
CASE DENS OF
BEGIN
["H"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["D"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],YP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP,1)
END;
XPOS←XNEW;
END;
['42] YPOS←YPOS+YU+ILDB(TXTPNT);
['45]
BEGIN
INTEGER N,J;
N←ILDB(TXTPNT);
FOR J←1 STEP 1 UNTIL N DO IBP(TXTPNT);
END;
['46] LUND←XPOS;
['47]
BEGIN
INTEGER XP,YP;
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29))
%YCMP;
FOR XP←LUND STEP 1 UNTIL XPOS DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],YP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],YP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,YP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP,1)
END;
END;
['50] INTERCHAR←ILDB(TXTPNT);
['51]
BEGIN
INTEGER XP,YP,TH,THK;
THK←ILDB(TXTPNT);
YP←(YPOS-YOFF+((ILDB(TXTPNT) LSH 29) ASH -29));
FOR XP←LUND STEP 1 UNTIL XPOS DO
FOR TH←THK-1 STEP -1 UNTIL 0 DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],(YP+TH)%YCMP,(XP-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],(YP+TH)%YCMP,XP-XOFF,1);
["F"] ADDEL(PIC[0],PIC[PCLN]-(XP-XOFF)%XCMP,(YP+TH)%YCMP,1);
["T"] PUTEL(PIC[0],PIC[PCLN]-(XP-XOFF),YP+TH,1)
END;
END
END;
[2] XPOS←XPOS+((ILDB(TXTPNT) LSH 29) ASH -29);
[3] YPOS←ILDB(TXTPNT)*128+ILDB(TXTPNT)-YL;
[4]
BEGIN
INTEGER J,K,X0,Y0,N,W,DX;
Y0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
X0←ILDB(TXTPNT)*128+ILDB(TXTPNT);
DX←((ILDB(TXTPNT)*16384+ILDB(TXTPNT)*128+ILDB(TXTPNT))
LSH 15) ASH -15;
X0←(X0 ASH 9)+(DX MIN 0);
N←ILDB(TXTPNT)*128+ILDB(TXTPNT);
W←ILDB(TXTPNT)*128+ILDB(TXTPNT);
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN
FOR K←W-1 STEP -1 UNTIL 0 DO
CASE DENS OF
BEGIN
["H"]["D"] ADDEL(PIC[0],(J+Y0-YOFF)%YCMP,
(K+(X0 ASH -9)-XOFF)%XCMP,1);
["B"]["E"] PUTEL(PIC[0],J+Y0-YOFF,
K+(X0 ASH -9)-XOFF,1);
["F"] ADDEL(PIC[0],
PIC[PCLN]-(K+(X0 ASH -9)-XOFF)%XCMP,
(J+Y0-YOFF)%YCMP,1);
["T"] PUTEL(PIC[0],
PIC[PCLN]-(K+(X0 ASH -9)-XOFF),
J+Y0-YOFF,1)
END;
X0←X0+DX;
END;
END;
[5]
BEGIN
FNTN←ILDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←0;
END;
[6]
BEGIN
INTEGER PREVHT;
PREVHT←FTB+BASE;
FNTN←ILDB(TXTPNT);
FTH←FHD[FNTN,FNTHIG];
FTB←FHD[FNTN,FNTBAS];
BASE←(IF LINLEN=0 THEN 0 ELSE PREVHT-FTB);
END;
[7]['10]['13]
['16]['17]['20]['21]['22]['23]['24]['25]['26]
['27]['30]['31]['32]['33]['34]['35]['36]['37] ;
ELSE
BEGIN
IFC MAXESCAPE>0 THENC
IF ESCHIT<NESCAPE ∧ BYT(TXTPNT)>ESCL[ESCHIT+1]
THEN ESCHIT←ESCHIT+2;
IF ESCHIT>NESCAPE ∨ BYT(TXTPNT)<ESCF[ESCHIT]
∨ BYT(TXTPNT)>ESCL[ESCHIT+1] THEN
ENDC
IF EDGEDO THEN
CASE DENS OF
BEGIN
["H"]["D"]["B"]["E"]
CHRDEP(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP);
["T"]["F"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
END
ELSE
CASE DENS OF
BEGIN
["H"] CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["F"] CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["D"] CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["B"]["E"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
END;
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18)+INTERCHAR+UINTERCHAR;
LINLEN←LINLEN+1;
END
END;
['12] YPOS←YPOS+YU+XLINE;
['15] XPOS←LMAR;
['11]
BEGIN
INTEGER BLANW;
BLANW←(FHD[FNTN," "] LSH -18)+INTERCHAR+UINTERCHAR;
XPOS←LMAR+((9*BLANW+XPOS-LMAR-1)%(8*BLANW))*8*BLANW;
LINLEN←LINLEN+1;
END;
['14] BEGIN XPOS←LMAR; YPOS←TMAR; END;
ELSE
BEGIN
IFC MAXESCAPE>0 THENC
IF ESCHIT<NESCAPE ∧ BYT(TXTPNT)>ESCL[ESCHIT+1]
THEN ESCHIT←ESCHIT+2;
IF ESCHIT>NESCAPE ∨ BYT(TXTPNT)<ESCF[ESCHIT]
∨ BYT(TXTPNT)>ESCL[ESCHIT+1] THEN
ENDC
IF EDGEDO THEN
CASE DENS OF
BEGIN
["H"]["D"]["B"]["E"]
CHRDEP(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP);
["F"]["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
END
ELSE
IF LDB(TXTPNT)≠" " THEN CASE DENS OF
BEGIN
["H"] CHR3X2(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["F"] CHR3Y4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["D"] CHR6X4(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["B"]["E"] CHR1X1(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF);
["T"] CHRPED(FNTN,LDB(TXTPNT),PIC[0],
YPOS-BASE-YOFF,XPOS-XOFF,YCMP,XCMP)
END;
XPOS←XPOS+(FHD[FNTN,LDB(TXTPNT)] LSH -18)
+INTERCHAR+UINTERCHAR; LINLEN←LINLEN+1;
END
END;
END"ASSLP";
END "ASSEMBLE";
END "NOTEOF";
comment display page;
IF ¬SPOOLFLAG∧¬NODPY THEN
BEGIN "SPOOLF"
SAFE INTEGER ARRAY DDB[2:(PIC[BYBI] MAX 2),
0:IF DENS="B"∨DENS="T"∨DENS="E"∨OWNCH
THEN 0 ELSE DDSIZ];
IF WHITELET THEN
BEGIN
INTEGER ARRAY TRANS[0:PIC[BMAX]];
J←PIC[BMAX]; K←J-(J LSH -1);
FOR I←0 STEP 1 UNTIL J DO
TRANS[I]←I XOR K;
PERBIT(PIC[0],TRANS[0]);
END;
DDINIT;
IF ¬OWNCH THEN
BEGIN
MAPGRY(IF DENS="D" THEN 1.5 ELSE 1,PIC[BYBI],TRUE);
GRAY(PIC[0]);
FOR I←2 STEP 1 UNTIL PIC[BYBI] DO DDSTOR(DDB[I,0]);
CASE PIC[BYBI] OF
BEGIN
[1] VID1(PIC[0],DBUF);
[3] VID3(PIC[0],DDB[3,0],DDB[2,0],DBUF);
[4] VID4(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF);
[5] VID5(PIC[0],DDB[5,0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF)
END;
FOR J←1,1 DO DPYUP(SYNMAP(0));
FOR I←1 STEP 1 UNTIL PIC[BYBI]-1 DO IF SYNMAP(I)>0 THEN
FOR J←1,1 DO DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
PRINT(" DONE"); IF HELPACT THEN FIRST2; CRLF;
UNGRAY(PIC[0]);
END
ELSE
BEGIN
VIDONE(PIC[0],IF PIC[BYBI]>2 THEN '7776 ELSE '7777);
DPYUP(-1); DPYUP(-1);
CALL(0,"SNEAKW"); comment don't wipe out screen right away;
CRLF;
END;
END "SPOOLF";
IF DENS="H"∨DENS="T" THEN FPN←FPN+FPNR+.5 ELSE
IF DENS="F"∨DENS="B" THEN FPN←(PN←FPN)+1 ELSE
IF DENS="E" THEN FPN←FPN+FPNR+1/4.5 ELSE
IF DENS="D" THEN FPN←(PN←FPN)+2;
END "NONZERO";
END "PAGES"
UNTIL PN<0;
END "PICTURE";
END "DENSITY";
END "FILE";
END IFC MAXESCAPE>0 THENC "XGPSYG" ELSEC "XGPSYN" ENDC;